home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / lsp / mislib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  7.9 KB  |  373 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "mislib.h"
  5. init_mislib(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     base[0]= VV[0];
  9.     (void)simple_symlispcall_no_event(VV[34],base+0,1);
  10.     MM(VV[35],L2,start,size,data);
  11.     base[0]= VV[9];
  12.     base[1]= VV[10];
  13.     (void)simple_symlispcall_no_event(VV[36],base+0,2);
  14.     base[0]= VV[11];
  15.     base[1]= VV[12];
  16.     (void)simple_symlispcall_no_event(VV[36],base+0,2);
  17.     MF(VV[37],L7,start,size,data);
  18.     MF(VV[38],L8,start,size,data);
  19.     data->v.v_self[27]=VV[27]=string_to_object(VV[27]);
  20.     vs_top=sup;
  21.     MF(VV[39],L9,start,size,data);
  22.     MF(VV[40],L10,start,size,data);
  23.     vs_top=vs_base=base;
  24. }
  25. /*    macro definition for TIME    */
  26.  
  27. static L2()
  28. {    register object *base=vs_base;
  29.     register object *sup=base+VM3;
  30.     vs_reserve(VM3);
  31.     check_arg(2);
  32.     vs_top=sup;
  33.     {object V1=base[0]->c.c_cdr;
  34.     if(endp(V1))invalid_macro_call();
  35.     base[2]= (V1->c.c_car);
  36.     V1=V1->c.c_cdr;
  37.     if(!endp(V1))invalid_macro_call();}
  38.     base[3]= list(2,VV[7],base[2]);
  39.     base[4]= list(3,VV[5],VV[6],base[3]);
  40.     base[5]= listA(6,VV[1],VV[2],VV[3],VV[4],base[4],VV[8]);
  41.     vs_top=(vs_base=base+5)+1;
  42.     return;
  43. }
  44. /*    function definition for LEAP-YEAR-P    */
  45.  
  46. static L7()
  47. {    register object *base=vs_base;
  48.     register object *sup=base+VM4;
  49.     vs_reserve(VM4);
  50.     check_arg(1);
  51.     vs_top=sup;
  52. TTL:;
  53.     base[2]= base[0];
  54.     base[3]= VV[13];
  55.     vs_top=(vs_base=base+2)+2;
  56.     Lmod();
  57.     vs_top=sup;
  58.     base[1]= vs_base[0];
  59.     if(number_compare(small_fixnum(0),base[1])==0){
  60.     goto T11;}
  61.     base[1]= Cnil;
  62.     vs_top=(vs_base=base+1)+1;
  63.     return;
  64. T11:;
  65.     base[3]= base[0];
  66.     base[4]= VV[14];
  67.     vs_top=(vs_base=base+3)+2;
  68.     Lmod();
  69.     vs_top=sup;
  70.     base[2]= vs_base[0];
  71.     if(!(((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil)){
  72.     goto T16;}
  73.     base[2]= Ct;
  74.     vs_top=(vs_base=base+2)+1;
  75.     return;
  76. T16:;
  77.     base[3]= base[0];
  78.     base[4]= VV[15];
  79.     vs_top=(vs_base=base+3)+2;
  80.     Lmod();
  81.     vs_top=sup;
  82.     base[2]= vs_base[0];
  83.     base[3]= (number_compare(small_fixnum(0),base[2])==0?Ct:Cnil);
  84.     vs_top=(vs_base=base+3)+1;
  85.     return;
  86. }
  87. /*    function definition for NUMBER-OF-DAYS-FROM-1900    */
  88.  
  89. static L8()
  90. {    register object *base=vs_base;
  91.     register object *sup=base+VM5;
  92.     vs_reserve(VM5);
  93.     check_arg(1);
  94.     vs_top=sup;
  95. TTL:;
  96.     base[1]= one_minus(base[0]);
  97.     base[3]= number_minus(base[0],VV[16]);
  98.     base[2]= number_times(base[3],VV[17]);
  99.     base[4]= base[1];
  100.     base[5]= VV[13];
  101.     vs_top=(vs_base=base+4)+2;
  102.     Lfloor();
  103.     vs_top=sup;
  104.     base[3]= vs_base[0];
  105.     base[6]= base[1];
  106.     base[7]= VV[14];
  107.     vs_top=(vs_base=base+6)+2;
  108.     Lfloor();
  109.     vs_top=sup;
  110.     base[5]= vs_base[0];
  111.     base[4]= number_negate(base[5]);
  112.     base[6]= base[1];
  113.     base[7]= VV[15];
  114.     vs_top=(vs_base=base+6)+2;
  115.     Lfloor();
  116.     vs_top=sup;
  117.     base[5]= vs_base[0];
  118.     base[6]= VV[18];
  119.     vs_top=(vs_base=base+2)+5;
  120.     Lplus();
  121.     return;
  122. }
  123. /*    function definition for DECODE-UNIVERSAL-TIME    */
  124.  
  125. static L9()
  126. {    register object *base=vs_base;
  127.     register object *sup=base+VM6;
  128.     vs_reserve(VM6);
  129.     if(vs_top-vs_base<1) too_few_arguments();
  130.     if(vs_top-vs_base>2) too_many_arguments();
  131.     vs_base=vs_base+1;
  132.     if(vs_base>=vs_top){vs_top=sup;goto T37;}
  133.     vs_top=sup;
  134.     goto T38;
  135. T37:;
  136.     base[1]= symbol_value(VV[19]);
  137. T38:;
  138.     base[2]= Cnil;
  139.     base[3]= Cnil;
  140.     base[4]= Cnil;
  141.     base[5]= Cnil;
  142.     base[6]= Cnil;
  143.     base[7]= Cnil;
  144.     base[8]= Cnil;
  145.     base[9]= number_times(base[1],VV[20]);
  146.     base[0]= number_minus(base[0],base[9]);
  147.     base[9]= base[0];
  148.     base[10]= VV[12];
  149.     vs_top=(vs_base=base+9)+2;
  150.     Lfloor();
  151.     if(vs_base<vs_top){
  152.     base[5]= vs_base[0];
  153.     vs_base++;
  154.     }else{
  155.     base[5]= Cnil;}
  156.     if(vs_base<vs_top){
  157.     base[0]= vs_base[0];
  158.     }else{
  159.     base[0]= Cnil;}
  160.     vs_top=sup;
  161.     base[9]= base[5];
  162.     base[10]= VV[21];
  163.     vs_top=(vs_base=base+9)+2;
  164.     Lmod();
  165.     vs_top=sup;
  166.     base[8]= vs_base[0];
  167.     base[9]= base[0];
  168.     base[10]= VV[20];
  169.     vs_top=(vs_base=base+9)+2;
  170.     Lfloor();
  171.     if(vs_base<vs_top){
  172.     base[4]= vs_base[0];
  173.     vs_base++;
  174.     }else{
  175.     base[4]= Cnil;}
  176.     if(vs_base<vs_top){
  177.     base[0]= vs_base[0];
  178.     }else{
  179.     base[0]= Cnil;}
  180.     vs_top=sup;
  181.     base[9]= base[0];
  182.     base[10]= VV[22];
  183.     vs_top=(vs_base=base+9)+2;
  184.     Lfloor();
  185.     if(vs_base<vs_top){
  186.     base[3]= vs_base[0];
  187.     vs_base++;
  188.     }else{
  189.     base[3]= Cnil;}
  190.     if(vs_base<vs_top){
  191.     base[2]= vs_base[0];
  192.     }else{
  193.     base[2]= Cnil;}
  194.     vs_top=sup;
  195.     base[10]= base[5];
  196.     base[11]= VV[23];
  197.     vs_top=(vs_base=base+10)+2;
  198.     Lfloor();
  199.     vs_top=sup;
  200.     base[9]= vs_base[0];
  201.     base[7]= number_plus(VV[16],base[9]);
  202.     base[9]= Cnil;
  203. T65:;
  204.     base[12]= base[7];
  205.     vs_top=(vs_base=base+12)+1;
  206.     L8();
  207.     vs_top=sup;
  208.     base[11]= vs_base[0];
  209.     base[9]= number_minus(base[5],base[11]);
  210.     base[10]= base[9];
  211.     base[12]= base[7];
  212.     vs_top=(vs_base=base+12)+1;
  213.     L7();
  214.     vs_top=sup;
  215.     if((vs_base[0])==Cnil){
  216.     goto T75;}
  217.     base[11]= VV[23];
  218.     goto T73;
  219. T75:;
  220.     base[11]= VV[17];
  221. T73:;
  222.     if(!(number_compare(base[10],base[11])<0)){
  223.     goto T66;}
  224.     base[5]= one_plus(base[9]);
  225.     goto T63;
  226. T66:;
  227.     base[7]= number_plus(base[7],VV[24]);
  228.     goto T65;
  229. T63:;
  230.     base[9]= base[7];
  231.     vs_top=(vs_base=base+9)+1;
  232.     L7();
  233.     vs_top=sup;
  234.     if((vs_base[0])==Cnil){
  235.     goto T84;}
  236.     if(!(number_compare(base[5],VV[22])==0)){
  237.     goto T88;}
  238.     base[9]= base[2];
  239.     base[10]= base[3];
  240.     base[11]= base[4];
  241.     base[12]= VV[25];
  242.     base[13]= VV[26];
  243.     base[14]= base[7];
  244.     base[15]= base[8];
  245.     base[16]= Cnil;
  246.     base[17]= base[1];
  247.     vs_base=base+9;vs_top=base+18;
  248.     return;
  249. T88:;
  250.     if(!(number_compare(base[5],VV[22])>0)){
  251.     goto T84;}
  252.     base[5]= number_minus(base[5],VV[24]);
  253. T84:;
  254.     base[9]= VV[27];
  255. T105:;
  256.     if(!(number_compare(base[5],car(base[9]))<=0)){
  257.     goto T106;}
  258.     base[10]= make_fixnum(length(base[9]));
  259.     base[6]= number_minus(VV[28],base[10]);
  260.     goto T103;
  261. T106:;
  262.     base[5]= number_minus(base[5],car(base[9]));
  263.     base[9]= cdr(base[9]);
  264.     goto T105;
  265. T103:;
  266.     base[9]= base[2];
  267.     base[10]= base[3];
  268.     base[11]= base[4];
  269.     base[12]= base[5];
  270.     base[13]= base[6];
  271.     base[14]= base[7];
  272.     base[15]= base[8];
  273.     base[16]= Cnil;
  274.     base[17]= base[1];
  275.     vs_base=base+9;vs_top=base+18;
  276.     return;
  277. }
  278. /*    function definition for ENCODE-UNIVERSAL-TIME    */
  279.  
  280. static L10()
  281. {    register object *base=vs_base;
  282.     register object *sup=base+VM7;
  283.     vs_reserve(VM7);
  284.     if(vs_top-vs_base<6) too_few_arguments();
  285.     if(vs_top-vs_base>7) too_many_arguments();
  286.     vs_base=vs_base+6;
  287.     if(vs_base>=vs_top){vs_top=sup;goto T125;}
  288.     vs_top=sup;
  289.     goto T126;
  290. T125:;
  291.     base[6]= symbol_value(VV[19]);
  292. T126:;
  293.     base[2]= number_plus(base[2],base[6]);
  294.     base[7]= VV[29];
  295.     base[8]= base[5];
  296.     base[9]= VV[30];
  297.     vs_top=(vs_base=base+7)+3;
  298.     Lmonotonically_nondecreasing();
  299.     vs_top=sup;
  300.     if((vs_base[0])==Cnil){
  301.     goto T130;}
  302.     symlispcall_no_event(VV[41],base+8,0);
  303.     Llist();
  304.     vs_top=sup;
  305.     base[7]= vs_base[0];
  306.     base[8]= car(base[7]);
  307.     base[9]= cadr(base[7]);
  308.     base[10]= caddr(base[7]);
  309.     base[11]= cadddr(base[7]);
  310.     base[12]= car(cddddr(base[7]));
  311.     base[13]= cadr(cddddr(base[7]));
  312.     base[14]= caddr(cddddr(base[7]));
  313.     base[15]= cadddr(cddddr(base[7]));
  314.     base[16]= nth(8,base[7]);
  315.     base[18]= base[13];
  316.     base[19]= VV[14];
  317.     vs_top=(vs_base=base+18)+2;
  318.     Lmod();
  319.     vs_top=sup;
  320.     base[17]= vs_base[0];
  321.     base[18]= number_minus(base[13],base[17]);
  322.     base[5]= number_plus(base[5],base[18]);
  323.     base[17]= number_minus(base[5],base[13]);
  324.     if(!(number_compare(base[17],VV[32])<0)){
  325.     goto T153;}
  326.     base[5]= number_plus(base[5],VV[14]);
  327.     goto T130;
  328. T153:;
  329.     base[17]= number_minus(base[5],base[13]);
  330.     if(!(number_compare(base[17],VV[33])>=0)){
  331.     goto T130;}
  332.     base[5]= number_minus(base[5],VV[14]);
  333. T130:;
  334.     base[7]= base[5];
  335.     vs_top=(vs_base=base+7)+1;
  336.     L7();
  337.     vs_top=sup;
  338.     if((vs_base[0])==Cnil){
  339.     goto T160;}
  340.     if(number_compare(base[4],VV[26])>0){
  341.     goto T159;}
  342. T160:;
  343.     base[3]= number_minus(base[3],VV[24]);
  344. T159:;
  345.     base[9]= base[3];
  346.     base[11]= base[5];
  347.     vs_top=(vs_base=base+11)+1;
  348.     L8();
  349.     vs_top=sup;
  350.     base[10]= vs_base[0];
  351.     {object V2;
  352.     base[11]= VV[27];
  353.     base[12]= number_minus(VV[28],base[4]);
  354.     vs_top=(vs_base=base+11)+2;
  355.     Lbutlast();
  356.     vs_top=sup;
  357.     V2= vs_base[0];
  358.      vs_top=base+11;
  359.      while(!endp(V2))
  360.      {vs_push(car(V2));V2=cdr(V2);}
  361.     vs_base=base+9;}
  362.     Lplus();
  363.     vs_top=sup;
  364.     base[8]= vs_base[0];
  365.     base[7]= number_times(base[8],VV[12]);
  366.     base[8]= number_times(base[2],VV[20]);
  367.     base[9]= number_times(base[1],VV[22]);
  368.     base[10]= base[0];
  369.     vs_top=(vs_base=base+7)+4;
  370.     Lplus();
  371.     return;
  372. }
  373.